home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 041-050 / amok46 / programme / d2.mod < prev    next >
Text File  |  1993-11-04  |  40KB  |  1,491 lines
  1. (*
  2.  * -------------------------------------------------------------------------
  3.  *
  4.  *    :Program.    d2
  5.  *    :Contents.    Ein Druckprogramm.
  6.  *    :Author.    Reiner Nix
  7.  *    :Address.    Geranienhof 2, 5000 Köln 71 Seeberg
  8.  *    :Copyright.    Public Domain
  9.  *    :Language.    Modula-2
  10.  *    :Translator.    M2Amiga A-L V3.3d
  11.  *    :History.    V1.0     1.11.90
  12.  *    :History.    V1.1    21.11.90 (File-Requester dazu)
  13.  *    :Imports.    ARPFileReq,        AMOK #31 neu übersetzt
  14.  *    :Imports.    IntuitionTools,        siehe diese Diskette
  15.  *    :Imports.    AmigaGraphik,        siehe diese Diskette
  16.  *    :Imports.    IntuitionTools,        siehe diese Diskette
  17.  *    :Imports.    FileOut,        siehe diese Diskette
  18.  *    :Bugs.        Die Procedure DateToStr arbeitet anscheinend je nach
  19.  *    :Bugs.        Seitenwind, Glatteis und Laune. Dadurch ist das
  20.  *    :Bugs.        Ergebnis recht willkürlich.
  21.  *
  22.  * -------------------------------------------------------------------------
  23.  *)
  24. MODULE d2;
  25.  
  26. FROM    SYSTEM        IMPORT    ADR, LONGSET;
  27. FROM    Arts        IMPORT    Assert, TermProcedure;
  28. FROM    Exec        IMPORT    Wait, WaitPort, GetMsg, ReplyMsg;
  29. FROM    Graphics    IMPORT    FontStyleSet, FontFlagSet,
  30.                 TextAttr,
  31.                 TextFontPtr;
  32. FROM    Intuition    IMPORT    pica, elite, fine, draft, letter, single,
  33.                 IDCMPFlags, IDCMPFlagSet,
  34.                 WindowFlags, WindowFlagSet,
  35.                 ScreenFlags, ScreenFlagSet,
  36.                 NewWindow, IntuiMessage, Preferences,
  37.                 WindowPtr, IntuiMessagePtr, GadgetPtr,
  38.                 RemoveGadget, AddGadget, GetPrefs;
  39. FROM    Dos        IMPORT    Date, DateStamp;
  40. FROM    Workbench    IMPORT    WBObjectType,
  41.                 DiskObjectPtr;
  42. FROM    Icon        IMPORT    GetDiskObject, FreeDiskObject,
  43.                 FindToolType, MatchToolValue;
  44. FROM    Arguments    IMPORT    NumArgs, GetArg;
  45. FROM    ASCII        IMPORT    sp, cr, eol, lf, ff, ht, csi, esc;
  46. FROM    DateConversions    IMPORT    DateInfo, FromDos, DateToStr;
  47. FROM    Heap        IMPORT    Allocate, Deallocate;
  48. FROM    Conversions    IMPORT    StrToVal;
  49. FROM    Str        IMPORT    Copy, Concat, FirstPos, Compare, Length;
  50. FROM    Strings        IMPORT    Delete, Occurs;
  51. FROM    FileSystem    IMPORT    File, Response,
  52.                 Lookup, Close, ReadChar;
  53. FROM    FileMessage    IMPORT    StrPtr,
  54.                 ResponseText;
  55. FROM    IntuitionTools    IMPORT    initNewWindow, initTextAttr,
  56.                 enableGadgets, disableGadgets;
  57. FROM    AmigaGraphik    IMPORT    OpenWindow, CloseWindow, UseWindow,
  58.                 NewWindowSize, SetAPen,
  59.                 OpenFont, CloseFont, UseFont,
  60.                 Move, DrawBox, DrawLine, FillRectangle,
  61.                 WriteString, Write, WriteCard;
  62. FROM    IntuitionObjekte IMPORT    ObjektEreignis, ObjektTyp, ObjektEnde,
  63.                 ObjektPtr,
  64.                 EingabeOk,
  65.                 setzeTextZeichensatz, setzeEingabeZeichensatz,
  66.                 loescheObjekt, loescheAlleObjekte,
  67.                 aenderInfoSatz,
  68.                 erzeugeBooleanObjekt,
  69.                 erzeugeTextObjekt, erzeugeCardObjekt,
  70.                 frageObjektNr, findeObjekt, frageGadget,
  71.                 erneuerObjekt, verbindeObjekte,
  72.                 verarbeiteNachricht, frageEnde;
  73. IMPORT    FileOut;
  74. FROM    ARPFileReq    IMPORT    FileReq;
  75.  
  76.  
  77. CONST    keinFenster    ="Ausgabefenster ist nicht zu öffnen";
  78.     keinZeichensatz    ="Zeichensatz Topaz8 nicht zu öffnen";
  79.     ja        ="   Ja       ";
  80.     nein        ="   Nein     ";
  81.     minus        =" < ";
  82.     plus        =" > ";
  83.     entwurf        ="   Entwurf  ";
  84.     brief        ="   Brief    ";
  85.     Tpica        ="   Pica     ";
  86.     Telite        ="   Elite    ";
  87.     Tfine        ="   Fine     ";
  88.     frei        ="   Frei     ";
  89.     modula        ="   Modula   ";
  90.  
  91.     KopfID        = 1;
  92.     EinzelblattID    = 2;
  93.     VorschubID    = 3;
  94.     NummerierungID    = 4;
  95.     ZielID        = 5;
  96.     TabulatorID    = 6;    minusID    =1;    plusID =2;
  97.     RandObenID    = 9;
  98.     RandUntenID    =12;
  99.     RandLinksID    =15;
  100.     RandRechtsID    =18;
  101.     BlattLaengeID    =21;
  102.     QualitaetID    =24;
  103.     BreiteID    =25;
  104.     FormatID    =26;
  105.     EingabeID    =27;
  106.     OeffnenID    =28;
  107.  
  108.     MeldenID    =30;
  109.     WeiterID    =31;
  110.  
  111.     maxDateiname    =45;
  112.  
  113.  
  114. TYPE    TZustand    =(Text, Satz1, Satz2, Bemerkung);
  115.  
  116.     TDateiname    =ARRAY[0..maxDateiname+1] OF CHAR;
  117.  
  118.     TQualitaet    =(Entwurf, Brief);
  119.     TBreite        =(Pica, Elite, Fine);
  120.     TFormat        =(Frei, Modula);
  121.  
  122.     TEinstellung    =RECORD Kopf, Einzelblatt,
  123.                 Vorschub, Nummerierung    :BOOLEAN;
  124.                 Ziel            :TDateiname;
  125.                 Tabulator,
  126.                 RandOben, RandUnten,
  127.                 RandLinks, RandRechts,
  128.                 BlattLaenge        :CARDINAL;
  129.                 Qualitaet        :TQualitaet;
  130.                 Breite            :TBreite;
  131.                 Format            :TFormat
  132.                 END;
  133.  
  134.  
  135. VAR    Fenster, MFenster        :WindowPtr;
  136.     NachrichtPtr            :IntuiMessagePtr;
  137.     Nachricht            :IntuiMessage;
  138.     Programmende,
  139.     DruckMeldung, DruckWeiter    :BOOLEAN;
  140.     Topaz8, Pearl8            :TextFontPtr;
  141.  
  142.     Einstellung            :TEinstellung;
  143.     EingabeText, Programmname    :TDateiname;
  144.     ErstesArgument            :INTEGER;
  145.  
  146.  
  147. PROCEDURE UpString        (VAR Satz        :ARRAY OF CHAR);
  148.  
  149. VAR    i    :CARDINAL;
  150.  
  151. BEGIN
  152. i := 0;
  153. WHILE (i < CARDINAL (HIGH (Satz))) AND (Satz[i] # 0C) DO
  154.   CASE Satz[i] OF
  155.   | 'a'..'z': Satz[i] := CAP (Satz[i]);
  156.   | 'ä'     : Satz[i] := "Ä"
  157.   ELSE
  158.     END;
  159.   INC (i)
  160.   END
  161. END UpString;
  162.  
  163.  
  164. PROCEDURE BenutzeStandard    (VAR Einstellung    :TEinstellung);
  165.  
  166. BEGIN
  167. WITH Einstellung DO
  168.   Kopf        := TRUE;
  169.   Einzelblatt    := FALSE;
  170.   Vorschub    := TRUE;
  171.   Nummerierung    := TRUE;
  172.   Ziel        := "Prt:";
  173.   Tabulator    := 8;
  174.   RandOben    := 0;        RandUnten    := 0;
  175.   RandLinks    := 1;        RandRechts    := 92;
  176.   BlattLaenge    := 72;
  177.   Qualitaet    := Entwurf;
  178.   Breite    := Elite;
  179.   Format    := Modula
  180.   END
  181. END BenutzeStandard;
  182.  
  183.  
  184. PROCEDURE BenutzePreferences    (VAR Einstellung    :TEinstellung);
  185.  
  186. VAR    Prefs    :Preferences;
  187.  
  188. BEGIN
  189. GetPrefs (ADR (Prefs), SIZE (Preferences));
  190. WITH Einstellung DO
  191.   WITH Prefs DO
  192.     IF paperType = single THEN
  193.       Einzelblatt := TRUE END;
  194.     RandLinks := printLeftMargin;
  195.     RandRechts := printRightMargin;
  196.     BlattLaenge := paperLength;
  197.     IF    printQuality = draft THEN
  198.       Qualitaet := Entwurf
  199.     ELSIF printQuality = letter THEN
  200.       Qualitaet := Brief
  201.       END;
  202.     IF    printPitch = pica THEN
  203.       Breite := Pica
  204.     ELSIF printPitch = elite THEN
  205.       Breite := Elite
  206.     ELSIF printPitch = fine THEN
  207.       Breite := Fine
  208.       END
  209.     END
  210.   END
  211. END BenutzePreferences;
  212.  
  213.  
  214. PROCEDURE BenutzeIcon        (VAR Einstellung    :TEinstellung;
  215.                  VAR ErstesArgument    :INTEGER);
  216.  
  217. VAR    Programmicon        :DiskObjectPtr;
  218.     Laenge            :INTEGER;
  219.     ToolType        :POINTER TO ARRAY [0..128] OF CHAR;
  220.  
  221.  
  222.   PROCEDURE CheckBooleanTool    (VAR Tool        :BOOLEAN;
  223.                        Toolname        :ARRAY OF CHAR);
  224.  
  225.  
  226.   BEGIN
  227.   ToolType := FindToolType (Programmicon^.toolTypes, ADR (Toolname));
  228.   IF ToolType # NIL THEN
  229.     IF    MatchToolValue (ToolType, ADR ("Ja")) OR
  230.           MatchToolValue (ToolType, ADR ("ja")) OR
  231.           MatchToolValue (ToolType, ADR ("JA")) THEN
  232.       Tool := TRUE
  233.     ELSIF MatchToolValue (ToolType, ADR ("Nein")) OR
  234.           MatchToolValue (ToolType, ADR ("nein")) OR
  235.           MatchToolValue (ToolType, ADR ("NEIN")) THEN
  236.       Tool := FALSE
  237.       END
  238.     END
  239.   END CheckBooleanTool;
  240.  
  241.  
  242.   PROCEDURE CheckCardinalTool    (VAR Tool        :CARDINAL;
  243.                      Toolname        :ARRAY OF CHAR);
  244.  
  245.   VAR    Negativ, Fehler        :BOOLEAN;
  246.       Zahl            :LONGINT;
  247.  
  248.   BEGIN
  249.   ToolType := FindToolType (Programmicon^.toolTypes, ADR (Toolname));
  250.   IF ToolType # NIL THEN
  251.     StrToVal (ToolType^, Zahl, Negativ, 10, Fehler);
  252.     IF NOT (Fehler) AND (0 <= Zahl) AND (Zahl <= 1000) THEN
  253.       Tool := CARDINAL (Zahl)
  254.       END
  255.     END
  256.   END CheckCardinalTool;
  257.  
  258.  
  259. (* BenutzeIcon *)
  260. BEGIN
  261. WITH Einstellung DO
  262.   GetArg (0, Programmname, Laenge);
  263.   Programmicon := GetDiskObject (ADR (Programmname));
  264.   IF (Programmicon # NIL) AND (Programmicon^.type = project) THEN
  265.     ToolType := Programmicon^.defaultTool;
  266.     Copy (Programmname, ToolType^);
  267.     FreeDiskObject (Programmicon);
  268.     Programmicon := GetDiskObject (ADR (Programmname));
  269.     ErstesArgument := 0
  270.   ELSE
  271.     ErstesArgument := 1
  272.     END;
  273.   IF Programmicon # NIL THEN
  274.     CheckBooleanTool (Kopf, "KOPF");
  275.     CheckBooleanTool (Einzelblatt, "EINZELBLATT");
  276.     CheckBooleanTool (Vorschub, "VORSCHUB");
  277.     CheckBooleanTool (Nummerierung, "NUMMERIERUNG");
  278.     ToolType := FindToolType (Programmicon^.toolTypes, ADR ("ZIEL"));
  279.     IF ToolType # NIL THEN
  280.       Copy (Ziel, ToolType^)
  281.       END;
  282.     CheckCardinalTool (Tabulator, "TABULATOR");
  283.     CheckCardinalTool (RandOben, "RANDOBEN");
  284.     CheckCardinalTool (RandUnten, "RANDUNTEN");
  285.     CheckCardinalTool (RandLinks, "RANDLINKS");
  286.     CheckCardinalTool (RandRechts, "RANDRECHTS");
  287.     CheckCardinalTool (BlattLaenge, "BLATTLÄNGE");
  288.     ToolType := FindToolType (Programmicon^.toolTypes, ADR ("QUALITÄT"));
  289.     IF ToolType # NIL THEN
  290.       IF    MatchToolValue (ToolType, ADR ("Entwurf")) OR
  291.             MatchToolValue (ToolType, ADR ("ENTWURF")) THEN
  292.         Qualitaet := Entwurf
  293.       ELSIF MatchToolValue (ToolType, ADR ("Brief")) OR
  294.             MatchToolValue (ToolType, ADR ("BRIEF")) THEN
  295.         Qualitaet := Brief
  296.         END
  297.       END;
  298.     ToolType := FindToolType (Programmicon^.toolTypes, ADR ("BREITE"));
  299.     IF ToolType # NIL THEN
  300.       IF    MatchToolValue (ToolType, ADR ("Pica")) OR
  301.             MatchToolValue (ToolType, ADR ("PICA")) THEN
  302.         Breite := Pica
  303.       ELSIF MatchToolValue (ToolType, ADR ("Elite")) OR
  304.             MatchToolValue (ToolType, ADR ("ELITE")) THEN
  305.         Breite := Elite
  306.       ELSIF MatchToolValue (ToolType, ADR ("Fine")) OR
  307.             MatchToolValue (ToolType, ADR ("FINE")) THEN
  308.         Breite := Fine
  309.         END
  310.       END;
  311.     ToolType := FindToolType (Programmicon^.toolTypes, ADR ("FORMAT"));
  312.     IF ToolType # NIL THEN
  313.       IF    MatchToolValue (ToolType, ADR ("Frei")) OR
  314.             MatchToolValue (ToolType, ADR ("FREI")) THEN
  315.         Format := Frei
  316.       ELSIF MatchToolValue (ToolType, ADR ("Modula")) OR
  317.             MatchToolValue (ToolType, ADR ("MODULA")) THEN
  318.         Format := Modula
  319.         END
  320.       END;
  321.     FreeDiskObject (Programmicon)
  322.     END
  323.   END
  324. END BenutzeIcon;
  325.  
  326.  
  327. PROCEDURE schreibeInfo;
  328.  
  329. VAR    i            :CARDINAL;
  330.  
  331. BEGIN
  332. SetAPen (1);
  333. Move ( 40, 31); WriteString ("Kopfzeile drucken");
  334. Move ( 40, 40); WriteString ("Einzelblätter bedrucken");
  335. Move ( 40, 49); WriteString ("Blattvorschub am Dateiende");
  336. Move ( 40, 58); WriteString ("Zeilen nummerieren");
  337. Move ( 40, 67); WriteString ("Ausgabequalität");
  338. Move ( 40, 76); WriteString ("Zeichenbreite");
  339. Move ( 40, 85); WriteString ("Formatierung");
  340. SetAPen  (2);
  341. DrawBox  (20, 14, 620,156);
  342. SetAPen  (1);
  343. DrawBox  (21, 15, 619,155); DrawBox  ( 22, 16, 618,154);
  344. DrawLine (23, 16,  23,154); DrawLine (617, 16, 617,154);
  345. SetAPen  (2);
  346. DrawBox  (20,214, 620,239);
  347. SetAPen  (1);
  348. DrawBox  (21,215, 619,238); DrawBox  ( 22,216, 618,237);
  349. DrawLine (23,216,  23,237); DrawLine (617,215, 617,237)
  350. END schreibeInfo;
  351.  
  352.  
  353. PROCEDURE MeldenAktion        (    Ereignis        :ObjektEreignis;
  354.                      objekt        :ObjektPtr);
  355. BEGIN
  356.   CASE frageObjektNr (objekt) OF
  357.   | MeldenID: DruckMeldung := TRUE
  358.   | WeiterID: DruckWeiter := TRUE
  359.   ELSE
  360.     END
  361. END MeldenAktion;
  362.  
  363.  
  364. PROCEDURE Meldung        (    Text        :ARRAY OF CHAR;
  365.                      WeiterMoeglich    :BOOLEAN);
  366.  
  367. VAR    neuFenster        :NewWindow;
  368.     Signal            :LONGSET;
  369.     NachrichtPtr        :IntuiMessagePtr;
  370.  
  371. BEGIN
  372. initNewWindow (neuFenster,
  373.                20,194, 600,26, 1,2,
  374.                IDCMPFlagSet {},
  375.                WindowFlagSet {(*windowDrag, windowDepth,*)noCareRefresh},
  376.                NIL, NIL,
  377.                ADR (" Meldung "),
  378.                NIL, NIL,
  379.                50,25, -1,-1,
  380.                ScreenFlagSet {wbenchScreen});
  381. MFenster := OpenWindow (neuFenster);
  382. Assert (MFenster # NIL, ADR (keinFenster));
  383. UseWindow (MFenster); SetAPen (1);
  384. Move (20,20); WriteString (Text);
  385. IF WeiterMoeglich THEN
  386.   erzeugeBooleanObjekt (MFenster, 450,13, " Weiter ", WeiterID, melden,
  387.                         MeldenAktion)
  388.   END;
  389. erzeugeBooleanObjekt (MFenster, 520,13, " O.K. ", MeldenID, melden,
  390.                       MeldenAktion);
  391. DruckMeldung := FALSE; DruckWeiter := FALSE;
  392. WHILE NOT (DruckMeldung OR DruckWeiter) DO
  393.   Signal := Wait (LONGSET {Fenster^.userPort^.sigBit,
  394.                            MFenster^.userPort^.sigBit});
  395.     REPEAT
  396.     NachrichtPtr := GetMsg (Fenster^.userPort);
  397.     IF NachrichtPtr # NIL THEN
  398.       IF newSize IN NachrichtPtr^.class THEN
  399.         UseWindow (Fenster); NewWindowSize
  400.         END;
  401.       ReplyMsg (NachrichtPtr)
  402.       END
  403.     UNTIL NachrichtPtr = NIL;
  404.     REPEAT
  405.     NachrichtPtr := GetMsg (MFenster^.userPort);
  406.     IF NachrichtPtr # NIL THEN
  407.       verarbeiteNachricht (MFenster, NachrichtPtr^);
  408.       ReplyMsg (NachrichtPtr)
  409.       END
  410.     UNTIL NachrichtPtr = NIL
  411.   END;
  412. loescheAlleObjekte (MFenster);
  413. CloseWindow (MFenster);
  414. UseWindow (Fenster)
  415. END Meldung;
  416.  
  417.  
  418. PROCEDURE DruckeDatei        (    Quelle        :ARRAY OF CHAR;
  419.                  VAR Fehler        :BOOLEAN);
  420.  
  421. CONST    maxWort    =15;
  422.       R1    ="AND ARRAY BEGIN BY CASE CONST DEFINITION DIV DO ELSE ";
  423.       R2    ="ELSIF END EXIT EXPORT FOR FROM IF IMPLEMENTATION IMPORT ";
  424.       R3    ="IN LOOP MOD MODULE NOT OF OR POINTER PROCEDURE QUALIFIED ";
  425.       R4    ="RECORD REPEAT RETURN SET THEN TO TYPE UNTIL VAR WHILE WITH ";
  426.  
  427. VAR    QuellDatei, ZielDatei    :File;
  428.     Fehlermeldung        :ARRAY [0..80] OF CHAR;
  429.     FehlerText        :StrPtr;
  430.     Zustand            :TZustand;
  431.     BemerkungsTiefe,
  432.     SeitenNr, ZeilenNr,
  433.     ZeilenPos, SpaltenPos    :LONGCARD;
  434.     i            :CARDINAL;
  435.     Zeichen, AltesZeichen    :CHAR;
  436.     Wiederholen,
  437.     DruckAbbruch        :BOOLEAN;
  438.       Reserviert        :ARRAY [0..300] OF CHAR;
  439.  
  440.  
  441.   PROCEDURE KursivAn;
  442.  
  443.   BEGIN
  444.   FileOut.Write        (ZielDatei, csi);
  445.   FileOut.WriteString    (ZielDatei, "3m")
  446.   END KursivAn;
  447.  
  448.  
  449.   PROCEDURE KursivAus;
  450.  
  451.   BEGIN
  452.   FileOut.Write        (ZielDatei, csi);
  453.   FileOut.WriteString    (ZielDatei, "0m")
  454.   END KursivAus;
  455.  
  456.  
  457.   PROCEDURE KleinschriftAn;
  458.  
  459.   BEGIN
  460.   FileOut.Write        (ZielDatei, csi);
  461.   FileOut.WriteString    (ZielDatei, "4v")
  462.   END KleinschriftAn;
  463.  
  464.  
  465.   PROCEDURE KleinschriftAus;
  466.  
  467.   BEGIN
  468.   FileOut.Write        (ZielDatei, csi);
  469.   FileOut.WriteString    (ZielDatei, "3v")
  470.   END KleinschriftAus;
  471.  
  472.  
  473.   PROCEDURE FettAn;
  474.  
  475.   BEGIN
  476.   FileOut.Write        (ZielDatei, csi);
  477.   FileOut.WriteString    (ZielDatei, "1m")
  478.   END FettAn;
  479.  
  480.  
  481.   PROCEDURE FettAus;
  482.  
  483.   BEGIN
  484.   FileOut.Write        (ZielDatei, csi);
  485.   FileOut.WriteString    (ZielDatei, "0m")
  486.   END FettAus;
  487.  
  488.  
  489.   PROCEDURE UnterstreichenAn;
  490.  
  491.   BEGIN
  492.   FileOut.Write        (ZielDatei, csi);
  493.   FileOut.WriteString    (ZielDatei, "4m")
  494.   END UnterstreichenAn;
  495.  
  496.  
  497.   PROCEDURE UnterstreichenAus;
  498.  
  499.   BEGIN
  500.   FileOut.Write        (ZielDatei, csi);
  501.   FileOut.WriteString    (ZielDatei, "0m")
  502.   END UnterstreichenAus;
  503.  
  504.  
  505.   PROCEDURE frageDatum        (VAR DatumsText        :ARRAY OF CHAR);
  506.  
  507.   CONST DatumsFormat        ="%d.%t %Y  %H:%M";
  508.         Monate  ="Januar|Februar|März|April|Mai|Juni|Juli|August|September|Oktober|November|Dezember|";
  509.  
  510.   VAR    Datum            :Date;
  511.       DatumsInfo        :DateInfo;
  512.  
  513.   BEGIN
  514.   DateStamp (ADR (Datum));
  515.   FromDos (Datum, DatumsInfo);
  516.   DateToStr (DatumsInfo, DatumsFormat, Monate, DatumsText)
  517.   END frageDatum;
  518.  
  519.  
  520.   PROCEDURE druckeKopf;
  521.  
  522.   VAR      i            :CARDINAL;
  523.       l            :INTEGER;
  524.       DatumsText        :ARRAY [0..30] OF CHAR;
  525.  
  526.   BEGIN
  527.   WITH Einstellung DO
  528.     IF Kopf THEN
  529.       IF Zustand = Bemerkung THEN
  530.         KursivAus END;
  531.       FOR i := 1 TO RandOben DO
  532.         FileOut.WriteLn        (ZielDatei);
  533.         INC (ZeilenPos)
  534.         END;
  535.       UnterstreichenAn;
  536.       l := RandRechts - RandLinks;
  537.       frageDatum (DatumsText);
  538.       DEC (l, 12 + Length (Quelle) + Length (DatumsText));
  539.       FileOut.WriteString    (ZielDatei, "Seite: ");
  540.       FileOut.WriteCard        (ZielDatei, SeitenNr,3);
  541.       FileOut.WriteString    (ZielDatei, "  '");
  542.       FileOut.WriteString    (ZielDatei, Quelle);
  543.       FileOut.Write    (ZielDatei, "'");
  544.       FOR i := 1 TO l DO
  545.         FileOut.Write (ZielDatei, sp)
  546.         END;
  547.       FileOut.WriteString    (ZielDatei, DatumsText);
  548.       FileOut.WriteLn        (ZielDatei);
  549.       UnterstreichenAus;
  550.       FileOut.WriteLn        (ZielDatei);
  551.       INC (ZeilenPos, 2);
  552.       SpaltenPos := RandLinks;
  553.       INC (SeitenNr);
  554.       IF Zustand = Bemerkung THEN
  555.         KursivAn
  556.         END
  557.       END
  558.     END
  559.   END druckeKopf;
  560.  
  561.  
  562.   PROCEDURE initDrucken;
  563.  
  564.   BEGIN
  565.   disableGadgets (Fenster, LONGSET {KopfID..OeffnenID});
  566.   DruckAbbruch := FALSE
  567.   END initDrucken;
  568.  
  569.  
  570.   PROCEDURE resetDrucken;
  571.  
  572.   BEGIN
  573.   Move (500,231); WriteString ("          ");
  574.   enableGadgets (Fenster, LONGSET {KopfID..OeffnenID})
  575.   END resetDrucken;
  576.  
  577.  
  578.   PROCEDURE startDrucken;
  579.  
  580.   BEGIN
  581.   WITH Einstellung DO
  582.     FileOut.Write     (ZielDatei, esc);        (* initPrinter *)
  583.     FileOut.WriteString    (ZielDatei, "#1");
  584.  
  585.     FileOut.Write    (ZielDatei, csi);        (* Left & Right *)
  586.     FileOut.WriteCard    (ZielDatei, RandLinks, 1);
  587.     FileOut.Write    (ZielDatei, ";");
  588.     FileOut.WriteCard    (ZielDatei, RandRechts, 1);
  589.     FileOut.Write    (ZielDatei, "s");
  590.  
  591.     FileOut.Write    (ZielDatei, csi);        (* NLQ *)
  592.     CASE Qualitaet OF
  593.     | Entwurf    :FileOut.WriteString    (ZielDatei, '1"z')
  594.     | Brief    :FileOut.WriteString    (ZielDatei, '2"z')
  595.     ELSE
  596.       END;
  597.  
  598.     FileOut.Write    (ZielDatei, csi);        (* Pitch *)
  599.     CASE Breite OF
  600.     | Pica    :FileOut.WriteString    (ZielDatei, '0w')
  601.     | Elite    :FileOut.WriteString    (ZielDatei, '2w')
  602.     | Fine    :FileOut.WriteString    (ZielDatei, '4w')
  603.     ELSE
  604.       END;
  605.  
  606.     SeitenNr := 1;
  607.     ZeilenNr := 1;
  608.     ZeilenPos := 1;
  609.     SpaltenPos := RandLinks;
  610.     druckeKopf;
  611.     IF Nummerierung THEN
  612.       KleinschriftAn;
  613.       FileOut.WriteCard    (ZielDatei, ZeilenNr, 5);
  614.       FileOut.Write        (ZielDatei, ":");
  615.       KleinschriftAus;
  616.       INC (ZeilenNr)
  617.       END
  618.     END
  619.   END startDrucken;
  620.  
  621.  
  622.   PROCEDURE stopDrucken;
  623.  
  624.   BEGIN
  625.   WITH Einstellung DO
  626.     IF Vorschub THEN
  627.       FileOut.Write    (ZielDatei, ff)
  628.       END;
  629.     FileOut.Write     (ZielDatei, esc);        (* initPrinter *)
  630.     FileOut.WriteString    (ZielDatei, "#1")
  631.     END
  632.   END stopDrucken;
  633.  
  634.  
  635.   PROCEDURE neueSeite;
  636.  
  637.   BEGIN
  638.   WITH Einstellung DO
  639.     FileOut.Write    (ZielDatei, ff);
  640.     ZeilenPos := 1;
  641.     IF Einzelblatt THEN
  642.       Meldung ("Seitenende erreicht.", FALSE)
  643.       END;
  644.     druckeKopf
  645.     END
  646.   END neueSeite;
  647.  
  648.  
  649.   PROCEDURE bearbeiteDruckNachricht;
  650.  
  651.   VAR    NachrichtPtr        :IntuiMessagePtr;
  652.       Nachricht        :IntuiMessage;
  653.  
  654.   BEGIN
  655.     REPEAT
  656.     NachrichtPtr := GetMsg (Fenster^.userPort);
  657.     IF NachrichtPtr # NIL THEN
  658.       Nachricht := NachrichtPtr^;
  659.       ReplyMsg (NachrichtPtr);
  660.       verarbeiteNachricht (Fenster, Nachricht);
  661.       IF newSize IN Nachricht.class THEN
  662.         NewWindowSize;
  663.         schreibeInfo
  664.       ELSIF closeWindow IN Nachricht.class THEN
  665.         DruckAbbruch := TRUE
  666.         END
  667.       END
  668.     UNTIL (NachrichtPtr = NIL)
  669.   END bearbeiteDruckNachricht;
  670.  
  671.  
  672.   PROCEDURE neueZeile;
  673.  
  674.   BEGIN
  675.   WITH Einstellung DO
  676.     IF ZeilenPos < BlattLaenge-RandUnten THEN
  677.       FileOut.WriteLn    (ZielDatei);
  678.       INC (ZeilenPos)
  679.     ELSE
  680.       neueSeite
  681.       END;
  682.     SpaltenPos := RandLinks;
  683.     END;
  684.   SetAPen (1);
  685.   Move (500,231); WriteString ("Zeile:");
  686.   Move (548,231); WriteCard (ZeilenNr,5)
  687.   END neueZeile;
  688.  
  689.  
  690.   PROCEDURE schreibeZeichen        (    Zeichen        :CHAR);
  691.  
  692.   BEGIN
  693.   bearbeiteDruckNachricht;
  694.   WITH Einstellung DO
  695.     IF SpaltenPos >= RandRechts THEN
  696.       neueZeile
  697.     ELSE
  698.       INC (SpaltenPos)
  699.       END;
  700.     FileOut.Write    (ZielDatei, Zeichen)
  701.     END
  702.   END schreibeZeichen;
  703.  
  704.  
  705.   PROCEDURE TesteModulaWort;
  706.  
  707.   VAR    i,j            :CARDINAL;
  708.       Puffer            :ARRAY [0..maxWort+2] OF CHAR;
  709.  
  710.   BEGIN
  711.   IF (Zustand # Text) OR (Zeichen < "A") OR ("Z" < Zeichen) THEN
  712.     schreibeZeichen (Zeichen);
  713.     RETURN
  714.     END;
  715.   i := 0;
  716.   WHILE (i < maxWort) AND ("A" <= Zeichen) AND (Zeichen <= "Z") DO
  717.     Puffer[i] := Zeichen; INC (i);
  718.     ReadChar (QuellDatei, Zeichen)
  719.     END;
  720.   AltesZeichen := Zeichen; Wiederholen := TRUE;
  721.   IF i < maxWort THEN
  722.     Puffer[i] := sp;
  723.     Puffer[i+1] := 0C;
  724.     IF (i > 1) AND (Occurs (Reserviert, 0, Puffer, FALSE) # -1) THEN
  725.       FettAn;
  726.       j := 0;
  727.       WHILE j < i DO
  728.         schreibeZeichen (Puffer[j]); INC (j)
  729.         END;
  730.       FettAus
  731.     ELSE
  732.       j := 0;
  733.       WHILE j < i DO
  734.         schreibeZeichen (Puffer[j]); INC (j)
  735.         END
  736.       END
  737.   ELSE
  738.     j := 0;
  739.     WHILE j < i DO
  740.       schreibeZeichen (Puffer[j]); INC (j)
  741.       END;
  742.     WHILE ("A" <= Zeichen) AND (Zeichen <= "Z") DO
  743.       schreibeZeichen (Zeichen);
  744.       ReadChar (QuellDatei, Zeichen)
  745.       END
  746.     END
  747.   END TesteModulaWort;
  748.  
  749.  
  750. (* DruckeDatei *)
  751. BEGIN
  752. Fehler := FALSE;
  753. WITH Einstellung DO
  754.   IF RandLinks + 5 > RandRechts THEN
  755.     Meldung ("Linker und rechter Rand sind unpassend. Abbrechen ?", TRUE);
  756.     IF DruckMeldung THEN
  757.       Fehler := TRUE;
  758.       RETURN
  759.       END
  760.     END;
  761.   IF Tabulator >= RandRechts THEN
  762.     Meldung ("Der Tabulatorwert ist seltsam. Abbrechen ?", TRUE);
  763.     IF DruckMeldung THEN
  764.       Fehler := TRUE;
  765.       RETURN
  766.       END
  767.     END;
  768.   IF RandOben + 5 + RandUnten >= BlattLaenge THEN
  769.     Meldung ("Blattlänge, oberer und unterer Rand sind seltsam. Abbrechen ?",
  770.              TRUE);
  771.     IF DruckMeldung THEN
  772.       Fehler := TRUE;
  773.       RETURN
  774.       END
  775.     END
  776.   END;
  777. initDrucken;
  778. Copy (Reserviert, R1); Concat (Reserviert, R2);
  779. Concat (Reserviert, R3); Concat (Reserviert, R4);
  780.   REPEAT
  781.   Lookup (QuellDatei, Quelle, 512, FALSE);
  782.   IF QuellDatei.res # done THEN
  783.     ResponseText (QuellDatei.res, FehlerText);
  784.     Close (QuellDatei);
  785.     Copy (Fehlermeldung, "Fehler beim Öffnen der Quelldatei: ");
  786.     Concat (Fehlermeldung, FehlerText^);
  787.     Meldung (Fehlermeldung, TRUE);
  788.     IF DruckMeldung THEN
  789.       Fehler := TRUE
  790.     ELSE
  791.       Fehler := NOT (FileReq (Quelle, Fenster, "D2: Quelldatei ?", FALSE))
  792.       END;
  793.     IF Fehler THEN
  794.       resetDrucken;
  795.       RETURN
  796.       END
  797.     END
  798.   UNTIL QuellDatei.res = done;
  799. Lookup (ZielDatei, Einstellung.Ziel, 0, TRUE);
  800. IF ZielDatei.res # done THEN
  801.   ResponseText (ZielDatei.res, FehlerText);
  802.   Close (ZielDatei);
  803.   Copy (Fehlermeldung, "Fehler beim Öffnen der Zieldatei: ");
  804.   Concat (Fehlermeldung, FehlerText^);
  805.   Meldung (Fehlermeldung, FALSE);
  806.   Fehler := TRUE;
  807.   resetDrucken;
  808.   RETURN
  809.   END;
  810.  
  811. Zustand := Text;
  812. Wiederholen := FALSE;
  813. BemerkungsTiefe:= 0;
  814. WITH Einstellung DO
  815.   startDrucken;
  816.   REPEAT
  817.     IF Wiederholen THEN
  818.       Zeichen := AltesZeichen;
  819.       Wiederholen := FALSE
  820.     ELSE
  821.       ReadChar (QuellDatei, Zeichen)
  822.       END;
  823.     IF Zeichen = ff THEN
  824.       neueSeite
  825.     ELSIF Zeichen = lf THEN
  826.       IF (Zustand = Satz1) OR (Zustand = Satz2) THEN
  827.         Zustand := Text
  828.         END;
  829.       neueZeile;
  830.       IF Nummerierung THEN
  831.         KleinschriftAn;
  832.         IF Zustand = Bemerkung THEN
  833.           KursivAus
  834.           END;
  835.         FileOut.WriteCard    (ZielDatei, ZeilenNr, 5);
  836.         FileOut.Write        (ZielDatei, ":");
  837.         KleinschriftAus;
  838.         INC (SpaltenPos, 6);
  839.         IF Zustand = Bemerkung THEN
  840.           KursivAn
  841.           END
  842.         END;
  843.       INC (ZeilenNr)
  844.     ELSIF (Zeichen = csi) OR (Zeichen = esc) THEN
  845.         REPEAT
  846.         FileOut.Write    (ZielDatei, Zeichen);
  847.         ReadChar (QuellDatei, Zeichen)
  848.         UNTIL (("A" <= CAP (Zeichen)) AND (CAP (Zeichen) <= "Z"))
  849.     ELSIF Zeichen = "'" THEN
  850.       IF Format = Modula THEN
  851.         CASE Zustand OF
  852.         | Text    :Zustand := Satz1
  853.         | Satz1    :Zustand := Text
  854.         ELSE
  855.           END
  856.         END;
  857.       schreibeZeichen (Zeichen)
  858.     ELSIF Zeichen = '"' THEN
  859.       IF Format = Modula THEN
  860.         CASE Zustand OF
  861.         | Text    :Zustand := Satz2
  862.         | Satz2    :Zustand := Text
  863.         ELSE
  864.           END
  865.         END;
  866.       schreibeZeichen (Zeichen)
  867.     ELSIF Zeichen = "(" THEN
  868.       IF (Format = Modula) AND ((Zustand = Text) OR (Zustand = Bemerkung)) THEN
  869.         ReadChar (QuellDatei, Zeichen);
  870.         IF Zeichen # "*" THEN
  871.           schreibeZeichen ("(");
  872.           AltesZeichen := Zeichen; Wiederholen := TRUE
  873.         ELSE
  874.           INC (BemerkungsTiefe);
  875.           IF Zustand = Text THEN
  876.             Zustand := Bemerkung;
  877.             KursivAn
  878.             END;
  879.           schreibeZeichen ("("); schreibeZeichen ("*")
  880.           END
  881.       ELSE
  882.         schreibeZeichen (Zeichen)
  883.         END
  884.     ELSIF Zeichen = "*" THEN
  885.       IF (Format = Modula) AND (Zustand = Bemerkung) THEN
  886.         schreibeZeichen (Zeichen);
  887.         ReadChar (QuellDatei, Zeichen);
  888.         IF Zeichen = ")" THEN
  889.           schreibeZeichen (Zeichen);
  890.           DEC (BemerkungsTiefe);
  891.           IF BemerkungsTiefe = 0 THEN
  892.             Zustand := Text;
  893.             KursivAus
  894.             END
  895.         ELSE
  896.           AltesZeichen := Zeichen; Wiederholen := TRUE
  897.           END
  898.       ELSE
  899.         schreibeZeichen (Zeichen)
  900.         END
  901.     ELSIF Zeichen = ht THEN
  902.       IF Tabulator = 0 THEN
  903.         FileOut.Write    (ZielDatei, Zeichen)
  904.       ELSE
  905.         schreibeZeichen (" ");
  906.         IF Nummerierung THEN
  907.           WHILE (SpaltenPos-RandLinks-6) MOD Tabulator # 0 DO
  908.             schreibeZeichen (" ")
  909.             END
  910.         ELSE
  911.           WHILE (SpaltenPos-RandLinks) MOD Tabulator # 0 DO
  912.             schreibeZeichen (" ")
  913.             END
  914.           END
  915.         END
  916.     ELSE (* CASE *)
  917.       IF Format = Modula THEN
  918.         TesteModulaWort
  919.       ELSE
  920.         schreibeZeichen (Zeichen)
  921.         END
  922.       END;
  923.     IF DruckAbbruch THEN
  924.       Meldung ("Druck abbrechen?", TRUE);
  925.       DruckAbbruch := DruckMeldung
  926.       END;
  927.     UNTIL DruckAbbruch OR QuellDatei.eof OR (QuellDatei.res # done)
  928.   END;
  929. stopDrucken;
  930. Close (ZielDatei);
  931. Close (QuellDatei);
  932. resetDrucken
  933. END DruckeDatei;
  934.  
  935.  
  936. PROCEDURE erneuerBoolean    (    objekt        :ObjektPtr;
  937.                      Wert        :BOOLEAN);
  938.  
  939. BEGIN
  940. IF Wert THEN
  941.   aenderInfoSatz (objekt, ja)
  942. ELSE
  943.   aenderInfoSatz (objekt, nein)
  944.   END
  945. END erneuerBoolean;
  946.  
  947.  
  948. PROCEDURE erneuerQualitaet    (    objekt        :ObjektPtr);
  949.  
  950. BEGIN
  951. CASE Einstellung.Qualitaet OF
  952. | Entwurf    :aenderInfoSatz (objekt, entwurf)
  953. | Brief        :aenderInfoSatz (objekt, brief)
  954.   END
  955. END erneuerQualitaet;
  956.  
  957.  
  958. PROCEDURE erneuerBreite        (    objekt        :ObjektPtr);
  959.  
  960. BEGIN
  961. CASE Einstellung.Breite OF
  962. | Pica        :aenderInfoSatz (objekt, Tpica)
  963. | Elite        :aenderInfoSatz (objekt, Telite)
  964. | Fine        :aenderInfoSatz (objekt, Tfine)
  965.   END
  966. END erneuerBreite;
  967.  
  968.  
  969. PROCEDURE erneuerFormat        (    objekt        :ObjektPtr);
  970.  
  971. BEGIN
  972. CASE Einstellung.Format OF
  973. | Frei        :aenderInfoSatz (objekt, frei);
  974. | Modula    :aenderInfoSatz (objekt, modula)
  975.   END
  976. END erneuerFormat;
  977.  
  978.  
  979. PROCEDURE BoolAktion        (    Ereignis        :ObjektEreignis;
  980.                      objekt        :ObjektPtr);
  981.  
  982. BEGIN
  983. WITH Einstellung DO
  984.   CASE frageObjektNr (objekt) OF
  985.   | KopfID:
  986.     Kopf := NOT (Kopf);
  987.     erneuerBoolean (objekt, Kopf)
  988.   | EinzelblattID:
  989.     Einzelblatt := NOT (Einzelblatt);
  990.     erneuerBoolean (objekt, Einzelblatt)
  991.   | VorschubID:
  992.     Vorschub := NOT (Vorschub);
  993.     erneuerBoolean (objekt, Vorschub)
  994.   | NummerierungID:
  995.     Nummerierung := NOT (Nummerierung);
  996.     erneuerBoolean (objekt, Nummerierung)
  997.     END
  998.   END
  999. END BoolAktion;
  1000.  
  1001.  
  1002. PROCEDURE MinusAktion        (    Ereignis        :ObjektEreignis;
  1003.                      objekt        :ObjektPtr);
  1004.  
  1005. VAR    n            :CARDINAL;
  1006.  
  1007. BEGIN
  1008. IF Ereignis # Wiederholung THEN
  1009.   RETURN
  1010.   END;
  1011. WITH Einstellung DO
  1012.   CASE frageObjektNr (objekt)-minusID OF
  1013.   | TabulatorID        :n := Tabulator;
  1014.   | RandObenID        :n := RandOben;
  1015.   | RandUntenID        :n := RandUnten;
  1016.   | RandLinksID     :n := RandLinks;
  1017.   | RandRechtsID    :n := RandRechts;
  1018.   | BlattLaengeID    :n := BlattLaenge
  1019.     END;
  1020.   IF n = 0 THEN
  1021.     RETURN
  1022.     END;
  1023.   DEC (n);
  1024.   CASE frageObjektNr (objekt)-minusID OF
  1025.   | TabulatorID        :Tabulator := n;
  1026.   | RandObenID        :RandOben := n;
  1027.   | RandUntenID        :RandUnten := n;
  1028.   | RandLinksID     :RandLinks := n;
  1029.   | RandRechtsID    :RandRechts := n;
  1030.   | BlattLaengeID    :BlattLaenge := n
  1031.     END;
  1032.   erneuerObjekt (findeObjekt (Fenster, frageObjektNr (objekt)-minusID))
  1033.   END
  1034. END MinusAktion;
  1035.  
  1036.  
  1037. PROCEDURE PlusAktion        (    Ereignis        :ObjektEreignis;
  1038.                      objekt        :ObjektPtr);
  1039.  
  1040. VAR    n            :CARDINAL;
  1041.  
  1042. BEGIN
  1043. IF Ereignis # Wiederholung THEN
  1044.   RETURN
  1045.   END;
  1046. WITH Einstellung DO
  1047.   CASE frageObjektNr (objekt)-plusID OF
  1048.   | TabulatorID        :n := Tabulator;
  1049.   | RandObenID        :n := RandOben;
  1050.   | RandUntenID        :n := RandUnten;
  1051.   | RandLinksID     :n := RandLinks;
  1052.   | RandRechtsID    :n := RandRechts;
  1053.   | BlattLaengeID    :n := BlattLaenge
  1054.     END;
  1055.   IF n >= 100 THEN
  1056.     RETURN
  1057.     END;
  1058.   INC (n);
  1059.   CASE frageObjektNr (objekt)-plusID OF
  1060.   | TabulatorID        :Tabulator := n;
  1061.   | RandObenID        :RandOben := n;
  1062.   | RandUntenID        :RandUnten := n;
  1063.   | RandLinksID     :RandLinks := n;
  1064.   | RandRechtsID    :RandRechts := n;
  1065.   | BlattLaengeID    :BlattLaenge := n
  1066.     END;
  1067.   erneuerObjekt (findeObjekt (Fenster, frageObjektNr (objekt)-plusID))
  1068.   END
  1069. END PlusAktion;
  1070.  
  1071.  
  1072. PROCEDURE QualitaetAktion    (    Ereignis        :ObjektEreignis;
  1073.                      objekt        :ObjektPtr);
  1074.  
  1075. BEGIN
  1076. WITH Einstellung DO
  1077.   CASE Qualitaet OF
  1078.   | Entwurf    :Qualitaet := Brief;
  1079.   | Brief        :Qualitaet := Entwurf
  1080.     END;
  1081.   erneuerQualitaet (objekt)
  1082.   END
  1083. END QualitaetAktion;
  1084.  
  1085.  
  1086. PROCEDURE BreiteAktion        (    Ereignis        :ObjektEreignis;
  1087.                      objekt        :ObjektPtr);
  1088.  
  1089. BEGIN
  1090. WITH Einstellung DO
  1091.   CASE Breite OF
  1092.   | Pica        :Breite := Elite
  1093.   | Elite        :Breite := Fine
  1094.   | Fine        :Breite := Pica
  1095.     END;
  1096.   erneuerBreite (objekt)
  1097.   END
  1098. END BreiteAktion;
  1099.  
  1100.  
  1101. PROCEDURE FormatAktion        (    Ereignis        :ObjektEreignis;
  1102.                      objekt        :ObjektPtr);
  1103.  
  1104. BEGIN
  1105. WITH Einstellung DO
  1106.   CASE Format OF
  1107.   | Frei    :Format := Modula
  1108.   | Modula    :Format := Frei
  1109.     END;
  1110.   erneuerFormat (objekt)
  1111.   END
  1112. END FormatAktion;
  1113.  
  1114.  
  1115. PROCEDURE BenutzeParameter    (    EingabeText    :ARRAY OF CHAR;
  1116.                  VAR ParameterFehler    :BOOLEAN);
  1117.  
  1118. CONST    G1     ="KOPF EINZELBLATT VORSCHUB NUMMERIERUNG ZIEL ";
  1119.     G2     ="TABULATOR RANDOBEN RANDUNTEN RANDLINKS RANDRECHTS ";
  1120.     G3    ="BLATTLÄNGE QUALITÄT BREITE FORMAT ";
  1121.  
  1122. VAR    i            :CARDINAL;
  1123.     Parameter        :TDateiname;
  1124.     Gesamt            :ARRAY [0..130] OF CHAR;
  1125.  
  1126.  
  1127.   PROCEDURE TesteBoolean    (VAR Boolean    :BOOLEAN;
  1128.                        Satz    :ARRAY OF CHAR);
  1129.  
  1130.   BEGIN
  1131.   UpString (Satz);
  1132.   IF    Compare (Satz, "JA") = 0 THEN
  1133.     Boolean := TRUE;
  1134.   ELSIF Compare (Satz, "NEIN") = 0 THEN
  1135.     Boolean := FALSE
  1136.   ELSE
  1137.     ParameterFehler := TRUE
  1138.     END
  1139.   END TesteBoolean;
  1140.  
  1141.  
  1142.   PROCEDURE TesteCardinal    (VAR Zahl    :CARDINAL;
  1143.                        Satz    :ARRAY OF CHAR);
  1144.  
  1145.   VAR    Negativ, Fehler        :BOOLEAN;
  1146.       iZahl            :LONGINT;
  1147.  
  1148.   BEGIN
  1149.   StrToVal (Satz, iZahl, Negativ, 10, Fehler);
  1150.   IF NOT (Fehler) AND (0 <= iZahl) AND (iZahl <= 1000) THEN
  1151.     Zahl := CARDINAL (iZahl)
  1152.   ELSE
  1153.     ParameterFehler := TRUE
  1154.     END
  1155.   END TesteCardinal;
  1156.  
  1157.  
  1158. (* BenutzeParameter *)
  1159. BEGIN
  1160. ParameterFehler := FALSE;
  1161. WITH Einstellung DO
  1162.   Copy (Gesamt, G1); Concat (Gesamt, G2); Concat (Gesamt, G3);
  1163.   i := 0;
  1164.   WHILE (i < CARDINAL (HIGH (EingabeText))) AND (EingabeText[i] # 0C) DO
  1165.     IF EingabeText[i] = sp THEN
  1166.       Delete (EingabeText, i, 1)
  1167.     ELSE
  1168.       INC (i)
  1169.       END
  1170.     END;
  1171.   i := CARDINAL (FirstPos (EingabeText, 0, "="));
  1172.   Copy (Parameter, EingabeText);
  1173.   Parameter[i] := sp; Parameter[i+1] := 0C;
  1174.   UpString (Parameter);
  1175.   Delete (EingabeText, 0, i+1);
  1176.   CASE Occurs (Gesamt, 0, Parameter, FALSE) OF
  1177.   |   0:
  1178.     TesteBoolean (Kopf, EingabeText);
  1179.     erneuerBoolean (findeObjekt (Fenster, KopfID), Kopf)
  1180.   |   5:
  1181.     TesteBoolean (Einzelblatt, EingabeText);
  1182.     erneuerBoolean (findeObjekt (Fenster, EinzelblattID), Einzelblatt)
  1183.   |  17:
  1184.     TesteBoolean (Vorschub, EingabeText);
  1185.     erneuerBoolean (findeObjekt (Fenster, VorschubID), Vorschub)
  1186.   |  26:
  1187.     TesteBoolean (Nummerierung, EingabeText);
  1188.     erneuerBoolean (findeObjekt (Fenster, NummerierungID), Nummerierung)
  1189.   |  39:
  1190.     Copy (Ziel, EingabeText);
  1191.     erneuerObjekt (findeObjekt (Fenster, ZielID))
  1192.   |  44:
  1193.     TesteCardinal (Tabulator, EingabeText);
  1194.     erneuerObjekt (findeObjekt (Fenster, TabulatorID))
  1195.   |  54:
  1196.     TesteCardinal (RandOben, EingabeText);
  1197.     erneuerObjekt (findeObjekt (Fenster, RandObenID))
  1198.   |  63:
  1199.     TesteCardinal (RandUnten, EingabeText);
  1200.     erneuerObjekt (findeObjekt (Fenster, RandUntenID))
  1201.   |  73:
  1202.     TesteCardinal (RandLinks, EingabeText);
  1203.     erneuerObjekt (findeObjekt (Fenster, RandLinksID))
  1204.   |  83:
  1205.     TesteCardinal (RandRechts, EingabeText);
  1206.     erneuerObjekt (findeObjekt (Fenster, RandRechtsID))
  1207.   |  94:
  1208.     TesteCardinal (BlattLaenge, EingabeText);
  1209.     erneuerObjekt (findeObjekt (Fenster, BlattLaengeID))
  1210.   | 105:
  1211.     UpString (EingabeText);
  1212.     IF    Compare (EingabeText, "ENTWURF") = 0 THEN
  1213.       Qualitaet := Entwurf;
  1214.       erneuerQualitaet (findeObjekt (Fenster, QualitaetID))
  1215.     ELSIF Compare (EingabeText, "BRIEF") = 0 THEN
  1216.       Qualitaet := Brief;
  1217.       erneuerQualitaet (findeObjekt (Fenster, QualitaetID))
  1218.     ELSE
  1219.       ParameterFehler := TRUE
  1220.       END
  1221.   | 114:
  1222.     UpString (EingabeText);
  1223.     IF    Compare (EingabeText, "PICA") = 0 THEN
  1224.       Breite := Pica;
  1225.       erneuerBreite (findeObjekt (Fenster, BreiteID))
  1226.     ELSIF Compare (EingabeText, "ELITE") = 0 THEN
  1227.       Breite := Elite;
  1228.       erneuerBreite (findeObjekt (Fenster, BreiteID))
  1229.     ELSIF Compare (EingabeText, "FINE") = 0 THEN
  1230.       Breite := Fine;
  1231.       erneuerBreite (findeObjekt (Fenster, BreiteID))
  1232.     ELSE
  1233.       ParameterFehler := TRUE
  1234.       END
  1235.   | 121:
  1236.     UpString (EingabeText);
  1237.     IF    Compare (EingabeText, "FREI") = 0 THEN
  1238.       Format := Frei;
  1239.       erneuerObjekt (findeObjekt (Fenster, FormatID))
  1240.     ELSIF Compare (EingabeText, "MODULA") = 0 THEN
  1241.       Format := Modula;
  1242.       erneuerObjekt (findeObjekt (Fenster, FormatID))
  1243.     ELSE
  1244.       ParameterFehler := TRUE
  1245.       END
  1246.     END
  1247.   END
  1248. END BenutzeParameter;
  1249.  
  1250.  
  1251. PROCEDURE OeffnenAktion        (    Ereignis        :ObjektEreignis;
  1252.                      objekt        :ObjektPtr);
  1253.  
  1254. VAR    Fehler            :BOOLEAN;
  1255.     Dateiname        :ARRAY [0..maxDateiname] OF CHAR;
  1256.  
  1257. BEGIN
  1258. Dateiname[0] := 0C;
  1259. IF FileReq (Dateiname, Fenster, "D2: Quelldatei ?", TRUE) THEN
  1260.   DruckeDatei (Dateiname, Fehler)
  1261.   END
  1262. END OeffnenAktion;
  1263.  
  1264.  
  1265. PROCEDURE verarbeiteEingabe    (    objekt        :ObjektPtr) :BOOLEAN;
  1266.  
  1267. VAR    Fehler            :BOOLEAN;
  1268.  
  1269. BEGIN
  1270. Fehler := FALSE;
  1271. IF frageEnde () = returnEnde THEN
  1272.   IF EingabeText[0] = 0C THEN
  1273.     Programmende := TRUE
  1274.   ELSE
  1275.     IF FirstPos (EingabeText, 0, "=") # -1 THEN
  1276.       BenutzeParameter (EingabeText, Fehler)
  1277.     ELSE
  1278.       DruckeDatei (EingabeText, Fehler)
  1279.       END;
  1280.     IF NOT Fehler THEN
  1281.       EingabeText[0] := 0C
  1282.       END
  1283.     END
  1284.   END;
  1285. RETURN NOT (Fehler)
  1286. END verarbeiteEingabe;
  1287.  
  1288.  
  1289. PROCEDURE startD2;
  1290.  
  1291. VAR    neuFenster    :NewWindow;
  1292.     textAttr    :TextAttr;
  1293.  
  1294. BEGIN
  1295. Programmende := FALSE;
  1296. initNewWindow (neuFenster,
  1297.            0,12, 640,244,
  1298.            0,1,
  1299.            IDCMPFlagSet {closeWindow, newSize, sizeVerify},
  1300.            WindowFlagSet {windowSizing, windowDrag, windowDepth,
  1301.                           noCareRefresh, windowClose},
  1302.            NIL,                (* firstGadget *)
  1303.            NIL,                (* Checkmark *)
  1304.            ADR (Programmname),
  1305.            NIL,                (* Screen *)
  1306.            NIL,                (* Bitmap *)
  1307.            100, 50, -1,-1,
  1308.            ScreenFlagSet {wbenchScreen});
  1309. Fenster := OpenWindow (neuFenster);
  1310. Assert (Fenster # NIL, ADR (keinFenster));
  1311. initTextAttr (textAttr, ADR ("topaz.font"), 8, FontStyleSet {}, FontFlagSet {});
  1312. Topaz8 := OpenFont (textAttr);
  1313. Assert (Topaz8 # NIL, ADR (keinZeichensatz));
  1314.  
  1315. initTextAttr (textAttr, ADR ("pearl.font"), 8, FontStyleSet {}, FontFlagSet {});
  1316. Pearl8 := OpenFont (textAttr);
  1317.  
  1318. UseWindow (Fenster); UseFont (Topaz8);
  1319. setzeTextZeichensatz ("topaz.font", 8, FontStyleSet {});
  1320. IF Pearl8 # NIL THEN
  1321.   setzeEingabeZeichensatz ("pearl.font", 8, FontStyleSet {})
  1322. ELSE
  1323.   setzeEingabeZeichensatz ("topaz.font", 8, FontStyleSet {})
  1324.   END;
  1325. schreibeInfo;
  1326.  
  1327. WITH Einstellung DO
  1328.   erzeugeBooleanObjekt  (Fenster, 450, 25, nein, KopfID,
  1329.                          melden, BoolAktion);
  1330.   erzeugeBooleanObjekt  (Fenster, 450, 34, nein, EinzelblattID,
  1331.                          melden, BoolAktion);
  1332.   erzeugeBooleanObjekt  (Fenster, 450, 43, nein, VorschubID,
  1333.                          melden, BoolAktion);
  1334.   erzeugeBooleanObjekt  (Fenster, 450, 52, nein, NummerierungID,
  1335.                          melden, BoolAktion);
  1336.   erzeugeBooleanObjekt  (Fenster, 450, 61, entwurf, QualitaetID,
  1337.                  melden, QualitaetAktion);
  1338.   erzeugeBooleanObjekt  (Fenster, 450, 70, Tpica, BreiteID,
  1339.                  melden, BreiteAktion);
  1340.   erzeugeBooleanObjekt  (Fenster, 450, 79, frei, FormatID,
  1341.                  melden, FormatAktion);
  1342.   erneuerBoolean   (findeObjekt (Fenster, KopfID),         Kopf);
  1343.   erneuerBoolean   (findeObjekt (Fenster, EinzelblattID),  Einzelblatt);
  1344.   erneuerBoolean   (findeObjekt (Fenster, VorschubID),     Vorschub);
  1345.   erneuerBoolean   (findeObjekt (Fenster, NummerierungID), Nummerierung);
  1346.   erneuerQualitaet (findeObjekt (Fenster, QualitaetID));
  1347.   erneuerBreite    (findeObjekt (Fenster, BreiteID));
  1348.   erneuerFormat    (findeObjekt (Fenster, FormatID));
  1349.  
  1350.   erzeugeCardObjekt     (Fenster, 450, 88, "Tabulator",
  1351.                  TabulatorID, -410, 0, 5, EingabeOk, Tabulator);
  1352.   erzeugeBooleanObjekt  (Fenster, 497, 88, minus, TabulatorID + minusID,
  1353.                  wiederholen, MinusAktion);
  1354.   erzeugeBooleanObjekt  (Fenster, 523, 88, plus, TabulatorID + plusID,
  1355.                  wiederholen, PlusAktion);
  1356.  
  1357.   erzeugeCardObjekt     (Fenster, 450, 97, "oberer Rand",
  1358.                  RandObenID, -410, 0, 5,EingabeOk, RandOben);
  1359.   erzeugeBooleanObjekt  (Fenster, 497, 97, minus, RandObenID + minusID,
  1360.                  wiederholen, MinusAktion);
  1361.   erzeugeBooleanObjekt  (Fenster, 523, 97, plus, RandObenID + plusID,
  1362.                  wiederholen, PlusAktion);
  1363.  
  1364.   erzeugeCardObjekt     (Fenster, 450,106, "unterer Rand",
  1365.                  RandUntenID, -410, 0, 5,EingabeOk, RandUnten);
  1366.   erzeugeBooleanObjekt  (Fenster, 497,106, minus, RandUntenID + minusID,
  1367.                  wiederholen, MinusAktion);
  1368.   erzeugeBooleanObjekt  (Fenster, 523,106, plus, RandUntenID + plusID,
  1369.                  wiederholen, PlusAktion);
  1370.  
  1371.   erzeugeCardObjekt     (Fenster, 450,115, "linker Rand",
  1372.                  RandLinksID, -410, 0, 5,EingabeOk, RandLinks);
  1373.   erzeugeBooleanObjekt  (Fenster, 497,115, minus, RandLinksID + minusID,
  1374.                  wiederholen, MinusAktion);
  1375.   erzeugeBooleanObjekt  (Fenster, 523,115, plus, RandLinksID + plusID,
  1376.                  wiederholen, PlusAktion);
  1377.  
  1378.   erzeugeCardObjekt     (Fenster, 450,124, "rechter Rand",
  1379.                  RandRechtsID, -410, 0, 5,EingabeOk, RandRechts);
  1380.   erzeugeBooleanObjekt  (Fenster, 497,124, minus, RandRechtsID + minusID,
  1381.                  wiederholen, MinusAktion);
  1382.   erzeugeBooleanObjekt  (Fenster, 523,124, plus, RandRechtsID + plusID,
  1383.                  wiederholen, PlusAktion);
  1384.  
  1385.   erzeugeCardObjekt     (Fenster, 450,133, "Blattlänge",
  1386.                  BlattLaengeID, -410, 0, 5,EingabeOk, BlattLaenge);
  1387.   erzeugeBooleanObjekt  (Fenster, 497,133, minus, BlattLaengeID + minusID,
  1388.                  wiederholen, MinusAktion);
  1389.   erzeugeBooleanObjekt  (Fenster, 523,133, plus, BlattLaengeID + plusID,
  1390.                    wiederholen, PlusAktion);
  1391.  
  1392.   erzeugeTextObjekt     (Fenster, 450,142, "Ziel",
  1393.                    ZielID, -410, 0, 20, maxDateiname, EingabeOk, Ziel);
  1394.   erzeugeTextObjekt     (Fenster, 110, 225, "Eingabe:",
  1395.                    EingabeID, -70, 0, maxDateiname, maxDateiname,
  1396.                    verarbeiteEingabe, EingabeText);
  1397.   erzeugeBooleanObjekt  (Fenster, 500, 225, " öffne ... ",
  1398.              OeffnenID, melden, OeffnenAktion);
  1399.  
  1400.   verbindeObjekte (Fenster, TabulatorID,   -1,            RandObenID,   -1, -1);
  1401.   verbindeObjekte (Fenster, RandObenID,    TabulatorID,   RandUntenID,  -1, -1);
  1402.   verbindeObjekte (Fenster, RandUntenID,   RandObenID,    RandLinksID,  -1, -1);
  1403.   verbindeObjekte (Fenster, RandLinksID,   RandObenID,    RandRechtsID, -1, -1);
  1404.   verbindeObjekte (Fenster, RandRechtsID,  RandLinksID,   BlattLaengeID,-1, -1);
  1405.   verbindeObjekte (Fenster, BlattLaengeID, RandRechtsID,  ZielID,       -1, -1);
  1406.   verbindeObjekte (Fenster, ZielID,        BlattLaengeID, EingabeID,    -1, -1);
  1407.   verbindeObjekte (Fenster, EingabeID,     ZielID,        -1,           -1, -1)
  1408.   END
  1409. END startD2;
  1410.  
  1411.  
  1412. PROCEDURE stopD2;
  1413.  
  1414. BEGIN
  1415. IF MFenster # NIL THEN
  1416.   loescheAlleObjekte (MFenster);
  1417.   CloseWindow (MFenster)
  1418.   END;
  1419. IF Fenster # NIL THEN
  1420.   loescheAlleObjekte (Fenster)
  1421.   END;
  1422. CloseFont (Pearl8);
  1423. CloseFont (Topaz8);
  1424. CloseWindow (Fenster)
  1425. END stopD2;
  1426.  
  1427.  
  1428. PROCEDURE verarbeiteParameter    (    ErstesArgument        :CARDINAL);
  1429.  
  1430. VAR    Fehler            :BOOLEAN;
  1431.     i,j, Laenge        :INTEGER;
  1432.     EingabeText        :TDateiname;
  1433.  
  1434. BEGIN
  1435. FOR i := ErstesArgument TO NumArgs () DO
  1436.   FOR j := 0 TO 5 DO
  1437.     SetAPen (0);
  1438.     FillRectangle (40,158+j*8, 550,166+j*8);
  1439.     IF i+j <= NumArgs () THEN
  1440.       GetArg (i+j, EingabeText, Laenge);
  1441.       SetAPen (1);
  1442.       Move ( 50,165+j*8);  WriteCard (i+j, 4);
  1443.       Move ( 90,165+j*8);  Write ("'"); WriteString (EingabeText); Write ("'")
  1444.       END
  1445.     END;
  1446.   GetArg (i, EingabeText, Laenge);
  1447.   IF EingabeText[0] # 0C THEN
  1448.     IF FirstPos (EingabeText, 0, "=") # -1 THEN
  1449.       BenutzeParameter (EingabeText, Fehler)
  1450.     ELSIF Occurs (EingabeText, 0, ".obj", FALSE) = -1 THEN
  1451.       DruckeDatei (EingabeText, Fehler)
  1452.       END
  1453.     END
  1454.   END;
  1455. SetAPen (0); FillRectangle (50,158, 550,206)
  1456. END verarbeiteParameter;
  1457.  
  1458.  
  1459. (* d2 *)
  1460. BEGIN
  1461. Fenster := NIL;
  1462. MFenster := NIL;
  1463. TermProcedure (stopD2);
  1464. BenutzeStandard (Einstellung);
  1465. BenutzePreferences (Einstellung);
  1466. BenutzeIcon (Einstellung, ErstesArgument);
  1467. startD2;
  1468.  
  1469. verarbeiteParameter (ErstesArgument);
  1470.  
  1471. WHILE NOT Programmende DO
  1472.   WaitPort (Fenster^.userPort);
  1473.     REPEAT
  1474.     NachrichtPtr := GetMsg (Fenster^.userPort);
  1475.     IF NachrichtPtr # NIL THEN
  1476.       Nachricht := NachrichtPtr^;
  1477.       ReplyMsg (NachrichtPtr);
  1478.       verarbeiteNachricht (Fenster, Nachricht);
  1479.       IF    closeWindow IN Nachricht.class THEN
  1480.         Programmende := TRUE
  1481.       ELSIF newSize IN Nachricht.class THEN
  1482.         NewWindowSize;
  1483.         schreibeInfo
  1484.       ELSIF sizeVerify IN Nachricht.class THEN
  1485.         (* keine Aktion, nur Synchronisation! *)
  1486.         END
  1487.       END
  1488.     UNTIL (NachrichtPtr = NIL) OR Programmende
  1489.   END
  1490. END d2.
  1491.